home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir31 / vbpiano.zip / VBPIANO.BAS < prev    next >
BASIC Source File  |  1994-11-19  |  3KB  |  108 lines
  1. ' MIDI API Functions for Windows 3.1
  2. Declare Function midiOutOpen Lib "mmsystem.dll" (hMidiOut As Integer, ByVal DeviceId As Integer, ByVal C As Long, ByVal I As Long, ByVal F As Long) As Integer
  3. Declare Function midiOutShortMsg Lib "mmsystem.dll" (ByVal hMidiOut As Integer, ByVal midiMessage As Long) As Integer
  4. Declare Function MidiOutClose Lib "mmsystem.dll" (ByVal hMidiOut As Integer) As Integer
  5.  
  6. Global midiMessageOut As Long
  7. Global midiData1 As Long
  8. Global midiData2 As Long
  9.  
  10. Global hMidiOut As Integer
  11.  
  12. ' The Patch number array used for current patch for each midi channel
  13. Global midiPatch(16) As Integer
  14.  
  15. ' The Volume array (velocity) used for each MIDI channel
  16. Global midiVolume(16) As Integer
  17.  
  18. ' The Pan array (Left - Center - Right) used for each MIDI channel
  19. Global midiPan(16) As Integer
  20.  
  21. ' The Octave array (piano keys octave shift) used for each MIDI channel
  22. Global octave(16) As Integer
  23.  
  24. ' The current Midi Channel out set on Piano form
  25. Global midiChannelOut As Integer
  26.  
  27. ' NoteRepeat used to stop the same key from repeating.
  28. Global noteRepeat As Integer
  29.  
  30. ' MIDI status messages
  31. Global Const NOTE_OFF = &H80
  32. Global Const NOTE_ON = &H90
  33. Global Const POLY_KEY_PRESS = &HA0
  34. Global Const CONTROLLER_CHANGE = &HB0
  35. Global Const PROGRAM_CHANGE = &HC0
  36. Global Const CHANNEL_PRESSURE = &HD0
  37. Global Const PITCH_BEND = &HE0
  38.  
  39. ' MIDI Controller Numbers Constants
  40. Global Const MOD_WHEEL = 1
  41. Global Const BREATH_CONTROLLER = 2
  42. Global Const FOOT_CONTROLLER = 4
  43. Global Const PORTAMENTO_TIME = 5
  44. Global Const MAIN_VOLUME = 7
  45. Global Const BALANCE = 8
  46. Global Const PAN = 10
  47. Global Const EXPRESS_CONTROLLER = 11
  48. Global Const DAMPER_PEDAL = 64
  49. Global Const PORTAMENTO = 65
  50. Global Const SOSTENUTO = 66
  51. Global Const SOFT_PEDAL = 67
  52. Global Const HOLD_2 = 69
  53. Global Const EXTERNAL_FX_DEPTH = 91
  54. Global Const TREMELO_DEPTH = 92
  55. Global Const CHORUS_DEPTH = 93
  56. Global Const DETUNE_DEPTH = 94
  57. Global Const PHASER_DEPTH = 95
  58. Global Const DATA_INCREMENT = 96
  59. Global Const DATA_DECREMENT = 97
  60.  
  61. 'MIDI Mapper
  62. Global Const MIDI_MAPPER = -1
  63.  
  64. ' MousePointer
  65. Global Const DEFAULT = 0
  66. Global Const HOURGLASS = 11
  67.  
  68. ' Show parameters
  69. Global Const MODAL = 1
  70. Global Const MODELESS = 0
  71.  
  72. Sub MidiOutOpenPort ()
  73.     Dim midiOpenError As Integer
  74.  
  75.     Dim msg, response  ' Declare variables.
  76.  
  77.     'Open MIDIOut using MIDI Mapper
  78.     midiOpenError = midiOutOpen(hMidiOut, MIDI_MAPPER, 0, 0, 0)
  79.  
  80.     If midiOpenError <> 0 Then
  81.     ' Put together a error message box
  82.     msg = "The MIDI Mapper would not open.  It is either already"
  83.     msg = msg & " in use or not installed correctly."
  84.     msg = msg & "  VB MIDI Piano will not make any sound until the"
  85.     msg = msg & " MIDI Mapper can be opened."
  86.  
  87.     response = MsgBox(msg, 48, "VB MIDI Piano MIDI Open Error")
  88.     End If
  89.  
  90. End Sub
  91.  
  92. Sub SendMidiOut ()
  93.     Dim midiMessage As Long
  94.     Dim lowint As Long
  95.     Dim highint As Long
  96.     Dim x As Integer
  97.     
  98.     'Pack MIDI message data into 4 byte long integer
  99.     lowint = (midiData1 * 256) + midiMessageOut
  100.     highint = (midiData2 * 256) * 256
  101.  
  102.     midiMessage = lowint + highint
  103.  
  104.     'Windows MIDI API function
  105.     x = midiOutShortMsg(hMidiOut, midiMessage)
  106. End Sub
  107.  
  108.